home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / nghelp.zip / FASTSCR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  10.7 KB  |  349 lines

  1. {$A+,B-,E+,F-,I+,N-,O-,R-,V-}
  2. {$UNDEF DEBUG}
  3. {$IFDEF DEBUG} {$D+,L+,S+} {$ELSE} {$D-,L-,S-} {$ENDIF}
  4. {$DEFINE USECRT}
  5. Unit FastScr;
  6.  
  7. Interface
  8.  
  9. Uses YNSystem{$IFDEF USECRT},YNCRT{$ENDIF};
  10.  
  11.  
  12. Type BorderTypes               = (NoBrdr,
  13.                                   SpaceBrdr,SingleBrdr,DoubleBrdr,
  14.                                   HorizDoubleVertSingleBrdr,
  15.                                   HorizSingleVertDoubleBrdr,
  16.                                   Hatch1Brdr,Hatch2Brdr,Hatch3Brdr);
  17.  
  18.      Borders                   = (HorizTop, HorizBottom,
  19.                                   VertLeft, VertRight, HorizBorders,
  20.                                   VertBorders, AllBorders);
  21.      BorderParts               = (TL,TR,BL,BR,HT,HB,VR,VL,LC,RC,TC,BC,CC);
  22.      BorderArray               = Array[TL..CC] of Char;
  23.  
  24. Const Black                     = $00;
  25.       Blue                      = $01;
  26.       Green                     = $02;
  27.       Cyan                      = $03;
  28.       Red                       = $04;
  29.       Magenta                   = $05;
  30.       Brown                     = $06;
  31.       LightGray                 = $07;
  32.       DarkGray                  = $08;
  33.       LightBlue                 = $09;
  34.       LightGreen                = $0A;
  35.       LightCyan                 = $0B;
  36.       LightRed                  = $0C;
  37.       LightMagenta              = $0D;
  38.       Yellow                    = $0E;
  39.       White                     = $0F;
  40.       Blink                     = $80;
  41.       BlackBG                   = $00;
  42.       BlueBG                    = $10;
  43.       GreenBG                   = $20;
  44.       CyanBG                    = $30;
  45.       RedBG                     = $40;
  46.       MagentaBG                 = $50;
  47.       BrownBG                   = $60;
  48.       LightGrayBG               = $70;
  49.  
  50.       BorderSt                 : Array [SpaceBrdr..Hatch3Brdr] of
  51.                                   BorderArray=
  52.                                   ('█████████████',
  53.                                    '┌┐└┘──││├┤┬┴┼',
  54.                                    '╔╗╚╝══║║╠╣╦╩╬',
  55.                                    '╒╕╘╛══││╞╡╤╧╪',
  56.                                    '╓╖╙╜──║║╟╢╥╙╫',
  57.                                    '░░░░░░░░░░░░░',
  58.                                    '▒▒▒▒▒▒▒▒▒▒▒▒▒',
  59.                                    '▓▓▓▓▓▓▓▓▓▓▓▓▓');
  60.  
  61.  
  62. Type StrScreen   = String[80];
  63.  
  64.      WindowCoord = Record
  65.       X1,Y1,X2,Y2 : Byte;
  66.      End;
  67.  
  68.      DisplayOBJ  = Object
  69.       vScreenPtr    : Pointer;
  70.       vWindow       : WindowCoord;
  71.       vWindowIgnore : Boolean;
  72.       vWidth        : Byte;
  73.  
  74.       Constructor Init;
  75.       Procedure   FastWrite(X,Y,Attr : Byte;St : StrScreen);
  76.       Procedure   FastPWrite(X,Y : Byte;St : StrScreen);
  77.       Procedure   WriteCenter(Y,Attr : Byte;St : StrScreen);
  78.       Procedure   WriteHi(X,Y,AttrHi,Attr : Byte;St : StrScreen);
  79.       Procedure   ChangeAttr(X,Y,Attr,Len : Byte);
  80.       Function    ReadChar(X,Y : Byte) : Char;
  81.       Function    ReadScreenLn(Y : Byte) : String;
  82.       Procedure   SetWindow(X1,Y1,X2,Y2 : Byte);
  83.       Procedure   TitleEngine(X1,Y1,X2,Y2 : Byte;Title : StrScreen);
  84.       Procedure   BoxEngine(X1,Y1,X2,Y2,Attr : Byte;Bordertype : BorderTypes;
  85.                             Filled : Boolean);
  86.       Function    WhereX : Byte;
  87.       Function    WhereY : Byte;
  88.       Procedure   GotoXY(X,Y : Byte);
  89.       Destructor  Done;
  90.      End;
  91.  
  92.  
  93.  
  94. Var Screen : DisplayOBJ;
  95.  
  96. Implementation
  97.  
  98. (*------ Externals ---------------------------------------------------------*)
  99. {$L FASTSCR.OBJ}
  100. {$F+}
  101. Procedure AsmWrite(Var ScrPtr;Wid,Col,Row,Attr : Byte;St : String); External;
  102. Procedure AsmPWrite(Var ScrPtr;Wid,Col,Row : Byte;St : String);     External;
  103. Procedure AsmAttr(Var ScrPtr;Wid,Col,Row,Attr,Len : Byte);          External;
  104. Procedure AsmMoveFromScreen(Var Source,Dest;Length : Word);         External;
  105. Procedure AsmMoveToScreen(Var Source,Dest;Length : Word);           External;
  106. {$F-}
  107. (*--------------------------------------------------------------------------*)
  108.  
  109. Function Duplicate(Ch : Char;Times : Byte) : String;
  110. Var F : String;
  111. Begin
  112.  FillChar(F,Times+1,Ch);
  113.  Byte(F[0]) := Times;
  114.  Duplicate := F;
  115. End;
  116.  
  117. (*--------------------------------------------------------------------------*)
  118.  
  119. Procedure FillWord(Var Dest;Width,Value : Word);
  120. Begin
  121.  if CheckSnow then
  122.   Inline($C4/$BE/Dest/            {         LES     DI,Dest[BP]       }
  123.          $8B/$8E/Width/           {         MOV     CX,Width[BP]      }
  124.          $8B/$9E/Value/           {         MOV     BX,Value[BP]      }
  125.          $FC/                     {         CLD                       }
  126.          $E3/$16/                 {         JCXZ    READY             }
  127.          $BA/$03DA/               {         MOV     DX,3DAH           }
  128.          $B4/$09/                 {         MOV     AH,9              }
  129.          $EC/                     { TEST1:  IN      AL,DX             }
  130.          $D0/$D8/                 {         RCR     AL,1              }
  131.          $72/$FB/                 {         JB      TEST1             }
  132.          $FA/                     {         CLI                       }
  133.          $EC/                     { TEST2:  IN      AL,DX             }
  134.          $22/$C4/                 {         AND     AL,AH             }
  135.          $74/$FB/                 {         JZ      TEST2             }
  136.          $8B/$C3/                 {         MOV     AX,BX             }
  137.          $AB/                     {         STOSW                     }
  138.          $FB/                     {         STI                       }
  139.          $E2/$EF) Else            {         LOOP    TEST1             }
  140.                                   { READY:                            }
  141.   Inline($C4/$BE/Dest/            {         LES     DI,Dest[BP]       }
  142.          $8B/$8E/Width/           {         MOV     CX,Width[BP]      }
  143.          $8B/$86/Value/           {         MOV     AX,Value[BP]      }
  144.          $FC/                     {         CLD                       }
  145.          $F3/$AB);                {         REP     STOSW             }
  146. End;
  147.  
  148.  
  149. Constructor DisplayOBJ.Init;
  150. Begin
  151.  vScreenPtr    := VideoPtr;
  152.  vWidth        := MaxCols;
  153.  vWindowIgnore := False;
  154.  
  155.  vWindow.X1 := 1;
  156.  vWindow.Y1 := 1;
  157.  vWindow.X2 := MaxCols;
  158.  vWindow.Y2 := MaxRows;
  159. End;
  160.  
  161. Procedure DisplayOBJ.FastWrite(X,Y,Attr : Byte;St : StrScreen);
  162. Begin
  163.  if vWindowIgnore then
  164.   AsmWrite(vScreenPtr^,vWidth,X,Y,Attr,St)
  165.   Else Begin
  166.         St := Copy(St,1,vWindow.X2-Pred(X)-Pred(vWindow.X1));
  167.         if Y+Pred(vWindow.Y1) <= vWindow.Y2 then
  168.         AsmWrite(vScreenPtr^,vWidth,Pred(vWindow.X1)+X,Pred(vWindow.Y1)+Y,
  169.                  Attr,St);
  170.        End;
  171. End;
  172.  
  173. Procedure DisplayOBJ.FastPWrite(X,Y : Byte;St : StrScreen);
  174. Begin
  175.  if vWindowIgnore then
  176.   ASMPWrite(vScreenPtr^,vWidth,X,Y,St)
  177.   Else Begin
  178.         St := Copy(St,1,vWindow.X2-Pred(X)-Pred(vWindow.X1));
  179.         if Y+Pred(vWindow.Y1) <= vWindow.Y2 then
  180.         ASMPWrite(vScreenPtr^,vWidth,Pred(vWindow.X1)+X,Pred(vWindow.Y1)+Y,St);
  181.        End;
  182. End;
  183.  
  184. Procedure DisplayOBJ.WriteCenter(Y,Attr : Byte;St : StrScreen);
  185. Var X : Integer;
  186. Begin
  187.  if vWindowIgnore then
  188.   Begin
  189.    X :=  (MaxCols - Length(St)) Div 2;
  190.    if X < 1 then X := 1;
  191.   End Else Begin
  192.             X := (Succ(vWindow.X2-vWindow.X1) - Length(St)) Div 2;
  193.            End;
  194.  FastWrite(X,Y,Attr,St);
  195. End;
  196.  
  197. Procedure DisplayOBJ.WriteHi(X,Y,AttrHi,Attr : Byte;St : StrScreen);
  198. Const HiMarker = '~';
  199.  
  200. Var P  : Byte;
  201.     Hi : Boolean;
  202.  
  203.   Procedure WriteBit(St : StrScreen);
  204.   Begin
  205.    if Hi then FastWrite(X,Y,AttrHi,St)
  206.     Else FastWrite(X,Y,Attr,St);
  207.   End;
  208.  
  209. Begin
  210.  Hi := False;
  211.  P := Pos(HiMarker,St);
  212.  While P <> 0 do
  213.   Begin
  214.    if P > 1 then
  215.    WriteBit(Copy(St,1,pred(P)));
  216.    Delete(St,1,P);
  217.    Inc(X,Pred(P));
  218.    P := Pos(HiMarker,St);
  219.    Hi := Not Hi;
  220.   End;
  221.  WriteBit(St);
  222. End;
  223.  
  224.  
  225. Procedure DisplayOBJ.ChangeAttr(X,Y,Attr,Len : Byte);
  226. Begin
  227.  if vWindowIgnore then
  228.   ASMAttr(vScreenPtr^,vWidth,X,Y,Attr,Len)
  229.   Else Begin
  230.         Inc(X,Pred(vWindow.X1));
  231.         Inc(Y,Pred(vWindow.Y1));
  232.         if (X <= vWindow.X2) and (Y <= vWindow.Y2) then
  233.          Begin
  234.           if X + Len > vWindow.X2 then
  235.            Len := vWindow.X2 - Pred(X);
  236.           ASMAttr(vScreenPtr^,vWidth,X,Y,Attr,Len)
  237.          End;
  238.        End;
  239. End;
  240.  
  241. Function DisplayOBJ.ReadChar(X,Y : Byte) : Char;
  242. Var Offset : Word;
  243.     Ch     : Word;
  244.     ChA    : Array [1..2] of Byte Absolute Ch;
  245. Begin
  246.  ReadChar := #0;
  247.  if (X>MaxCols) Or (Y>Succ(vWidth)) then Exit;
  248.  
  249.  Offset := Ofs(vScreenPtr^) + Pred(X)*2 + Pred(Y)*MaxCols*2;
  250.  AsmMoveFromScreen(Mem[Seg(vScreenPtr^):Offset],Ch,1);
  251.  ReadChar := Char(ChA[1]);
  252. End;
  253.  
  254. Function DisplayOBJ.ReadScreenLn(Y : Byte) : String;
  255. Var S    : String;
  256.     Loop : Byte;
  257. Begin
  258.  For Loop := 1 to MaxCols Do
  259.   S[Loop] := ReadChar(Loop,Y);
  260.  Byte(S[0]) := Loop;
  261.  ReadScreenLn := S;
  262. End;
  263.  
  264. Procedure DisplayOBJ.SetWindow(X1,Y1,X2,Y2 : Byte);
  265. Begin
  266. {$IFDEF USECRT}
  267.  YNCRT.Window(X1,Y1,X2,Y2);
  268. {$ENDIF}
  269.  vWindow.X1 := X1;
  270.  vWindow.Y1 := Y1;
  271.  vWindow.X2 := X2;
  272.  vWindow.Y2 := Y2;
  273. End;
  274.  
  275. Procedure DisplayOBJ.TitleEngine(X1,Y1,X2,Y2 : Byte;Title : StrScreen);
  276. Var sWindowIgnore : Boolean;
  277.     Width         : Integer;
  278. Begin
  279.  sWindowIgnore := vWindowIgnore;
  280.  vWindowIgnore := True;
  281.  
  282.  Width := (X2-X1)-2;
  283.  
  284.  if (Width>1) And (Title<>'') then
  285.   Begin
  286.    Delete(Title,Succ(Width),255);
  287.  
  288.    FastPWrite(X1+2,Y1,'['+ Title + ']');
  289.   End;
  290.  
  291.  vWindowIgnore := sWindowIgnore;
  292. End;
  293.  
  294. Procedure DisplayOBJ.BoxEngine(X1,Y1,X2,Y2,Attr : Byte;
  295.                                Bordertype : BorderTypes;Filled : Boolean);
  296. Var sWindowIgnore : Boolean;
  297.     Loop          : Byte;
  298. Begin
  299.  sWindowIgnore := vWindowIgnore;
  300.  vWindowIgnore := True;
  301.  
  302.  FastWrite(X1,Y1,Attr,BorderSt[BorderType,TL] +
  303.                       Duplicate(BorderSt[BorderType,HT],Pred(X2-X1)) +
  304.                       BorderSt[BorderType,TR]);
  305.  
  306.  if Filled then
  307.   For Loop := Succ(Y1) to Pred(Y2) Do
  308.    Begin
  309.     FastWrite(X1,Loop,Attr,BorderSt[BorderType,VL]+Duplicate(' ',Pred(X2-X1))+
  310.                            BorderSt[BorderType,VR]);
  311.    End
  312.   Else For Loop := Succ(Y1) to Pred(Y2) Do
  313.         Begin
  314.          FastWrite(X1,Loop,Attr,BorderSt[BorderType,VL]);
  315.          FastWrite(X2,Loop,Attr,BorderSt[BorderType,VR]);
  316.         End;
  317.  
  318.  FastWrite(X1,Y2,Attr,BorderSt[BorderType,BL] +
  319.                       Duplicate(BorderSt[BorderType,HB],Pred(X2-X1)) +
  320.                       BorderSt[BorderType,BR]);
  321.  
  322.  vWindowIgnore := sWindowIgnore;
  323. End;
  324.  
  325. Function DisplayOBJ.WhereX : Byte;
  326. Begin
  327.  WhereX := YNCrt.WhereX;
  328. End;
  329.  
  330. Function DisplayOBJ.WhereY : Byte;
  331. Begin
  332.  WhereY := YNCrt.WhereY;
  333. End;
  334.  
  335. Procedure DisplayOBJ.GotoXY(X,Y : Byte);
  336. Begin
  337.  YNCrt.GotoXY({Pred(vWindow.X1)+}X,{Pred(vWindow.Y1)+}Y);
  338. End;
  339.  
  340. Destructor DisplayOBJ.Done;
  341. Begin
  342. End;
  343.  
  344.  
  345.  
  346.  
  347. Begin
  348.  Screen.Init;
  349. End.